home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / apel / emu-xemacs.el.z / emu-xemacs.el
Encoding:
Text File  |  1998-05-21  |  3.8 KB  |  161 lines
  1. ;;; emu-xemacs.el --- emu API implementation for XEmacs
  2.  
  3. ;; Copyright (C) 1995 Free Software Foundation, Inc.
  4. ;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
  5.  
  6. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  7. ;; Version:
  8. ;;    $Id: emu-xemacs.el,v 7.19 1997/04/05 06:50:48 morioka Exp $
  9. ;; Keywords: emulation, compatibility, XEmacs
  10.  
  11. ;; This file is part of XEmacs.
  12.  
  13. ;; This program is free software; you can redistribute it and/or
  14. ;; modify it under the terms of the GNU General Public License as
  15. ;; published by the Free Software Foundation; either version 2, or (at
  16. ;; your option) any later version.
  17.  
  18. ;; This program is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26. ;; 02111-1307, USA.
  27.  
  28. ;;; Code:
  29.  
  30. ;;; @ face
  31. ;;;
  32.  
  33. (or (fboundp 'face-list)
  34.     (defalias 'face-list 'list-faces)
  35.     )
  36.  
  37. (or (memq 'underline (face-list))
  38.     (and (fboundp 'make-face)
  39.      (make-face 'underline)
  40.      ))
  41.  
  42. (or (face-differs-from-default-p 'underline)
  43.     (set-face-underline-p 'underline t))
  44.  
  45.  
  46. ;;; @ overlay
  47. ;;;
  48.  
  49. (condition-case err
  50.     (require 'overlay)
  51.   (error (defalias 'make-overlay 'make-extent)
  52.      (defalias 'overlay-put 'set-extent-property)
  53.      (defalias 'overlay-buffer 'extent-buffer)
  54.      (defun move-overlay (extent start end &optional buffer)
  55.        (set-extent-endpoints extent start end)
  56.        )
  57.      ))
  58.  
  59.  
  60. ;;; @ visible/invisible
  61. ;;;
  62.  
  63. (defmacro enable-invisible ())
  64.  
  65. (defmacro end-of-invisible ())
  66.  
  67. (defun invisible-region (start end)
  68.   (if (save-excursion
  69.     (goto-char start)
  70.     (eq (following-char) ?\n)
  71.     )
  72.       (setq start (1+ start))
  73.     )
  74.   (put-text-property start end 'invisible t)
  75.   )
  76.  
  77. (defun visible-region (start end)
  78.   (put-text-property start end 'invisible nil)
  79.   )
  80.  
  81. (defun invisible-p (pos)
  82.   (if (save-excursion
  83.     (goto-char pos)
  84.     (eq (following-char) ?\n)
  85.     )
  86.       (setq pos (1+ pos))
  87.     )
  88.   (get-text-property pos 'invisible)
  89.   )
  90.  
  91. (defun next-visible-point (pos)
  92.   (save-excursion
  93.     (if (save-excursion
  94.       (goto-char pos)
  95.       (eq (following-char) ?\n)
  96.       )
  97.     (setq pos (1+ pos))
  98.       )
  99.     (or (next-single-property-change pos 'invisible)
  100.     (point-max))
  101.     ))
  102.  
  103.  
  104. ;;; @ mouse
  105. ;;;
  106.  
  107. (defvar mouse-button-1 'button1)
  108. (defvar mouse-button-2 'button2)
  109. (defvar mouse-button-3 'button3)
  110.  
  111.  
  112. ;;; @ dired
  113. ;;;
  114.  
  115. (or (fboundp 'dired-other-frame)
  116.     (defun dired-other-frame (dirname &optional switches)
  117.       "\"Edit\" directory DIRNAME.  Like `dired' but makes a new frame."
  118.       (interactive (dired-read-dir-and-switches "in other frame "))
  119.       (switch-to-buffer-other-frame (dired-noselect dirname switches))
  120.       )
  121.     )
  122.  
  123.  
  124. ;;; @ string
  125. ;;;
  126.  
  127. (defmacro char-list-to-string (char-list)
  128.   "Convert list of character CHAR-LIST to string. [emu-xemacs.el]"
  129.   `(mapconcat #'char-to-string ,char-list ""))
  130.  
  131.  
  132. ;;; @@ to avoid bug of XEmacs 19.14
  133. ;;;
  134.  
  135. (or (string-match "^../"
  136.           (file-relative-name "/usr/local/share" "/usr/local/lib"))
  137.     ;; This function was imported from Emacs 19.33.
  138.     (defun file-relative-name (filename &optional directory)
  139.       "Convert FILENAME to be relative to DIRECTORY
  140. (default: default-directory). [emu-xemacs.el]"
  141.       (setq filename (expand-file-name filename)
  142.         directory (file-name-as-directory
  143.                (expand-file-name
  144.             (or directory default-directory))))
  145.       (let ((ancestor ""))
  146.     (while (not (string-match (concat "^" (regexp-quote directory))
  147.                   filename))
  148.       (setq directory (file-name-directory (substring directory 0 -1))
  149.         ancestor (concat "../" ancestor)))
  150.     (concat ancestor (substring filename (match-end 0)))
  151.     ))
  152.     )
  153.  
  154.     
  155. ;;; @ end
  156. ;;;
  157.  
  158. (provide 'emu-xemacs)
  159.  
  160. ;;; emu-xemacs.el ends here
  161.